home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / isconn_1 / module1.bas < prev    next >
BASIC Source File  |  1999-08-31  |  28KB  |  999 lines
  1. Attribute VB_Name = "Module1"
  2. '***************************************
  3. '** Note converting page to html code is not
  4. 'my code but I it is already sent to planet source code
  5. 'by someone that i don't no his name,sorry because I can't
  6. 'credit him.
  7. '***************************************
  8. Public MyAgent As Object
  9. Public imagemax As Integer
  10. Public addctrl As String
  11. Public bgsound As String
  12. Public zoo As Integer
  13. Public textmax As Integer
  14. Public cmax As Integer
  15. Public ctrltype As String
  16. Public dirty As Boolean
  17. Public shapemax As Integer
  18. Public linemax As Integer
  19. Public changes As Boolean
  20. Public curfile As String
  21. Public tcde(100) As String
  22. Public icde(100) As String
  23. Public runtime As Boolean
  24. Public ccindexx As Integer
  25. Public indexctrl As Integer
  26. Public bgclr As OLE_COLOR
  27. Public lclr As OLE_COLOR
  28. Public vclr As OLE_COLOR
  29. Public tclr As OLE_COLOR
  30. Dim string1, string2
  31. Private localTable As table
  32. Private regionGroup() As region
  33. Private tableArray() As Double
  34. Private objectCounter As Integer
  35. Private Const xLevel As Integer = 0, yLevel As Integer = 1, objectLevel As Integer = 2, drawnLevel As Integer = 3
  36.  
  37.  
  38. Private Type table
  39.     Width As Integer
  40.     Height As Integer
  41.     cellsWide As Integer
  42.     cellsTall As Integer
  43.     bgcolor As String
  44.     html As String
  45.     cellPadding As Integer
  46.     End Type
  47.  
  48.  
  49. Private Type region
  50.     html As String
  51.     Left As Long
  52.     Top As Long
  53.     Width As Long
  54.     Height As Long
  55.     bgcolor As String
  56.     rowSpan As Long
  57.     colSpan As Long
  58.     End Type
  59.     '***************************************************
  60.     'end declarations
  61.     'start code
  62.     '***************************************************
  63.  
  64. Public Declare Function RasEnumConnections Lib "RasApi32.dll" Alias "RasEnumConnectionsA" (lpRasCon As Any, lpcb As Long, lpcConnections As Long) As Long
  65.  
  66.  
  67. Public Declare Function RasGetConnectStatus Lib "RasApi32.dll" Alias "RasGetConnectStatusA" (ByVal hRasCon As Long, lpStatus As Any) As Long
  68.     '
  69.     Public Const RAS95_MaxEntryName = 256
  70.     Public Const RAS95_MaxDeviceType = 16
  71.     Public Const RAS95_MaxDeviceName = 32
  72.     '
  73.  
  74.  
  75. Public Type RASCONN95
  76.     dwSize As Long
  77.     hRasCon As Long
  78.     szEntryName(RAS95_MaxEntryName) As Byte
  79.     szDeviceType(RAS95_MaxDeviceType) As Byte
  80.     szDeviceName(RAS95_MaxDeviceName) As Byte
  81.     End Type
  82.     '
  83.  
  84.  
  85. Public Type RASCONNSTATUS95
  86.     dwSize As Long
  87.     RasConnState As Long
  88.     dwError As Long
  89.     szDeviceType(RAS95_MaxDeviceType) As Byte
  90.     szDeviceName(RAS95_MaxDeviceName) As Byte
  91.     End Type
  92.  
  93. Public Function Render() As String
  94.  
  95.     PrepareCrap 'get the crap ready For this new situation.
  96.     MakeTable
  97.     ClearAllRegions
  98.     Render = localTable.html 'return the resulting html
  99. End Function
  100.  
  101.  
  102.  
  103. Public Function AddRegion(html As String, Left As Double, Top As Double, Width As Double, Height As Double, bgcolor As String)
  104.  
  105.     objectCounter = objectCounter + 1
  106.     ReDim Preserve regionGroup(objectCounter)
  107.     If html = "" Then html = " "
  108.     regionGroup(objectCounter - 1).html = html
  109.     regionGroup(objectCounter - 1).Left = Left
  110.     regionGroup(objectCounter - 1).Top = Top
  111.     regionGroup(objectCounter - 1).Width = Width
  112.     regionGroup(objectCounter - 1).Height = Height
  113.     If bgcolor <> "" Then
  114.     regionGroup(objectCounter - 1).bgcolor = bgcolor
  115. End If
  116. End Function
  117.  
  118.  
  119.  
  120. Private Function ClearAllRegions()
  121.  
  122.     objectCounter = 0
  123.     Erase regionGroup()
  124. End Function
  125.  
  126.  
  127.  
  128.  
  129. Private Sub PrepareCrap()
  130.  
  131.     Erase tableArray()
  132.     localTable.cellsWide = calculateCellsWide
  133.     localTable.cellsTall = calculateCellsTall
  134.     localTable.html = "" 'set html to nothing so that old rendering doesn't show up here
  135.     localTable.Width = 0
  136.     localTable.Height = 0
  137.     ReDim tableArray(localTable.cellsWide, localTable.cellsTall, 4) 'resize the tablearray table
  138.  
  139.  
  140.     For i = 0 To localTable.cellsWide
  141.  
  142.  
  143.         For j = 0 To localTable.cellsTall
  144.             tableArray(i, j, objectLevel) = -1
  145.         Next j
  146.  
  147.     Next i
  148.  
  149. End Sub
  150.  
  151.  
  152.  
  153. Private Sub SortX()
  154.  
  155.     Dim edgeCoordinate As Integer
  156.  
  157.  
  158.     For i = 0 To localTable.cellsWide - 1
  159.         edgeCoordinate = 9999
  160.  
  161.  
  162.         For j = 0 To (objectCounter - 1)
  163.  
  164.  
  165.             If (i = 0) Then
  166.  
  167.  
  168.                 If (regionGroup(j).Left < edgeCoordinate) Then
  169.                     edgeCoordinate = regionGroup(j).Left
  170.                 End If
  171.  
  172.             ElseIf ((regionGroup(j).Left < edgeCoordinate) And (regionGroup(j).Left > tableArray((i - 1), 0, xLevel))) Then
  173.                 edgeCoordinate = regionGroup(j).Left
  174.             End If
  175.  
  176.         Next j
  177.  
  178.  
  179.  
  180.         If (edgeCoordinate <> 9999) Then
  181.             If i = localTable.cellsWide Then Beep
  182.             tableArray(i, 0, xLevel) = edgeCoordinate
  183.         End If
  184.  
  185.     Next i
  186.  
  187. End Sub
  188.  
  189.  
  190.  
  191. Private Sub SortY()
  192.  
  193.     Dim edgeCoordinate As Integer
  194.  
  195.  
  196.     For i = 0 To localTable.cellsTall - 1
  197.         edgeCoordinate = 9999
  198.  
  199.  
  200.         For j = 0 To (objectCounter - 1)
  201.  
  202.  
  203.             If (i = 0) Then
  204.  
  205.  
  206.                 If (regionGroup(j).Top < edgeCoordinate) Then
  207.                     edgeCoordinate = regionGroup(j).Top
  208.                 End If
  209.  
  210.             ElseIf ((regionGroup(j).Top < edgeCoordinate) And (regionGroup(j).Top > tableArray(0, (i - 1), yLevel))) Then
  211.                 edgeCoordinate = regionGroup(j).Top
  212.             End If
  213.  
  214.         Next j
  215.  
  216.  
  217.  
  218.         If (edgeCoordinate <> 9999) Then
  219.             tableArray(0, i, yLevel) = edgeCoordinate
  220.         End If
  221.  
  222.     Next i
  223.  
  224. End Sub
  225.  
  226.  
  227.  
  228. Private Function LayoutTable()
  229.  
  230.     localTable.html = localTable.html & "<TABLE BORDER=0 CELLSPACING=0 CELLPADDING=" & localTable.cellPadding & " BGCOLOR=" & localTable.bgcolor & ">"
  231.  
  232.  
  233.     If tableArray(0, 0, yLevel) <> 0 Then 'only Do this if there is some height to give to the vertical offset
  234.         localTable.html = localTable.html & "<TR>" 'start the row
  235.  
  236.  
  237.         If (tableArray(0, 0, xLevel) <> 0) Then 'only print this first cell if there is some horizontal offset
  238.             localTable.html = localTable.html & "<TD>" & vbCrLf
  239.             localTable.html = localTable.html & "<IMG SRC=trans.gif HEIGHT=" & Chr(34) & tableArray(0, 0, yLevel) & Chr(34) & " WIDTH=" & Chr(34) & tableArray(0, 0, xLevel) & Chr(34) & ">"
  240.             localTable.html = localTable.html & "</TD>"
  241.         End If
  242.  
  243.         'for loop starts here,
  244.         'this needs to go through and make cells and clearGifs with the g
  245.         '     eneric height, and variable widths
  246.  
  247.  
  248.         For j = 0 To localTable.cellsWide - 1
  249.             localTable.html = localTable.html & "<TD>"
  250.             localTable.html = localTable.html & "<IMG SRC=trans.gif HEIGHT=" & Chr(34) & "1" & Chr(34)
  251.  
  252.  
  253.             If j < localTable.cellsWide - 1 Then
  254.                 localTable.html = localTable.html & " WIDTH=" & Chr(34) & (tableArray(j + 1, 0, xLevel) - tableArray(j, 0, xLevel)) & Chr(34) & ">"
  255.             Else
  256.                 localTable.html = localTable.html & " WIDTH=" & Chr(34) & (localTable.Width - tableArray(j, 0, xLevel)) & Chr(34) & ">"
  257.             End If
  258.  
  259.             localTable.html = localTable.html & "</TD>"
  260.         Next j
  261.  
  262.         localTable.html = localTable.html & "</TR>"
  263.     End If
  264.  
  265.  
  266.  
  267.     For i = 0 To localTable.cellsTall - 1
  268.         localTable.html = localTable.html & "<TR>"
  269.  
  270.  
  271.         For j = 0 To localTable.cellsWide - 1
  272.  
  273.  
  274.             If ((tableArray(j, 0, xLevel) <> 0) And (j = 0)) Then 'only Do this is there is a horizontal width in the very first cell of the whole table
  275.                 localTable.html = localTable.html & "<TD>"
  276.              
  277.                 localTable.html = localTable.html & "<IMG SRC=trans.gif WIDTH=" & Chr(34) & "1" & Chr(34) 'print that width
  278.  
  279.  
  280.                 If i < localTable.cellsTall - 1 Then
  281.                     'here it is
  282.                     localTable.html = localTable.html & " HEIGHT=" & Chr(34) & Abs(tableArray(0, i + 1, yLevel) - tableArray(0, i, yLevel)) & Chr(34) & ">"
  283.                 Else
  284.                     localTable.html = localTable.html & " HEIGHT=" & Chr(34) & Abs(localTable.Height - tableArray